home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / C64 / A-Monthly Disks / (c)abh.d64 / event calendar (.txt) < prev    next >
Commodore BASIC  |  2007-02-04  |  8KB  |  336 lines
  1. 100 REM EVENT CALENDAR V1.2  G. ROGER GATHERS
  2. 110 POKE 53280,0:POKE 53281,0:POKE 646,5
  3. 120 PRINT CHR$(147):FOR I=1 TO 10:PRINT:NEXT I
  4. 130 PRINT TAB(10)"EVENT CALENDAR"
  5. 140 PRINT TAB(10)"--------------"
  6. 150 FOR I=1 TO 1000:NEXT I
  7. 160 N=100:DIM DT$(N),EV$(N),DS(N)
  8. 170 GOSUB 15000:REM LOAD CALENDAR DATA
  9. 180 INPUT "TODAY'S DATE (MM/DD/YY):[146]";ID$
  10. 190 DX$=ID$:GOSUB 14000:TD=DO
  11. 200 D8$=ID$:PRINT:GOSUB 16000
  12. 210 FOR I=1 TO 3000:NEXT I
  13. 220 REM MENU #1
  14. 230 PRINT CHR$(147)
  15. 240 F2=0:F5=0
  16. 250 FOR I=1 TO 6:PRINT:NEXT I
  17. 260 POKE 646,7
  18. 270 PRINT TAB(12)"*** MENU #1 ***":PRINT
  19. 280 POKE 646,3
  20. 290 PRINT TAB(6)"1 - DISPLAY ALL EVENTS"
  21. 300 PRINT TAB(6)"2 - LIST EVENTS ON PRINTER"
  22. 310 PRINT TAB(6)"3 - DISPLAY FUTURE EVENTS"
  23. 320 PRINT TAB(6)"4 - ADD/CREATE NEW EVENTS"
  24. 330 PRINT TAB(6)"5 - DELETE EVENTS"
  25. 340 PRINT TAB(6)"6 - EXIT PROGRAM"
  26. 350 POKE 646,7
  27. 360 PRINT:PRINT TAB(12)"ENTER SELECTION[146]"
  28. 370 GET A$:IF A$="" THEN 370
  29. 380 IF VAL(A$)>6 THEN PRINT TAB(13)"1 - 6 ONLY":FOR I=1 TO 1500:NEXT I:GOTO 230
  30. 390 ON VAL(A$) GOTO 9000,13000,10000,11000,12000,400
  31. 400 END
  32. 2000 REM MENU #2 (SUBROUTINE)
  33. 2010 PRINT CHR$(147)
  34. 2020 FOR I=1 TO 6:PRINT:NEXT I
  35. 2030 POKE 646,7
  36. 2040 PRINT TAB(12)"*** MENU #2 ***":PRINT
  37. 2050 POKE 646,3
  38. 2060 PRINT TAB(16)"A[146]NNUAL"
  39. 2070 PRINT TAB(16)"O[146]NE TIME"
  40. 2080 POKE 646,7
  41. 2090 PRINT:PRINT TAB(12)"ENTER SELECTION[146]"
  42. 2100 GET A$:IF A$="" THEN 2100
  43. 2110 IF A$="A" THEN 2150
  44. 2120 IF A$="O" THEN 2160
  45. 2130 PRINT TAB(13)"A OR O ONLY":FOR I=1 TO 1500:NEXT I
  46. 2140 (null) TO 2010
  47. 2150 F2=1:(null) TO 2170
  48. 2160 F2=2
  49. 2170 RETURN
  50. 5000 REM MENU #4 (SUBROUTINE)
  51. 5010 PRINT CHR$(147):PRINT:PRINT
  52. 5020 POKE 646,3
  53. 5030 PRINT TAB(6)"A[146]DD TO EXISTING FILE"
  54. 5040 PRINT TAB(6)"N[146]EW FILE"
  55. 5050 PRINT TAB(6)"R[146]ETURN TO MENU #1"
  56. 5060 POKE 646,7
  57. 5070 PRINT:PRINT TAB(12)"ENTER SELECTION[146]"
  58. 5080 GET A$:IF A$="" THEN 5080
  59. 5090 IF A$="A" THEN 5130
  60. 5100 IF A$="N" THEN 5140
  61. 5110 IF A$="R" THEN 5150
  62. 5120 PRINT "A, N, OR R ONLY":FOR I=1 TO 1500:NEXT I:(null) TO 5010
  63. 5130 F5=1:(null) TO 5160
  64. 5140 F5=2:(null) TO 5160
  65. 5150 F5=3
  66. 5160 RETURN
  67. 6000 REM READ FILES (SUBROUTINE)
  68. 6010 PRINT CHR$(147):PRINT:PRINT
  69. 6020 POKE 646,5
  70. 6030 IF F2=2 THEN 6060
  71. 6040 FI$="ANNLEVENTS"
  72. 6050 PRINT "READING ANNUAL EVENTS":(null) TO 6080
  73. 6060 FI$="ONETEVENTS"
  74. 6070 PRINT "READING ONE TIME EVENTS"
  75. 6080 OPEN 15,8,15
  76. 6090 OPEN 2,8,2,FI$+",S,R"
  77. 6100 GOSUB 18000
  78. 6110 POKE 646,3
  79. 6120 INPUT#2, LA$:REM LAST ACCESS DATE
  80. 6130 FOR I=1 TO N
  81. 6140 INPUT#2,DT$(I)
  82. 6150 IF DT$(I)="END" THEN 6180
  83. 6160 INPUT#2,EV$(I):INPUT#2,DS(I)
  84. 6170 NEXT I
  85. 6180 CLOSE 2:ND=I-1
  86. 6190 CLOSE 15
  87. 6200 RETURN
  88. 7000 REM WRITE FILE (SUBROUTINE)
  89. 7010 PRINT CHR$(147):PRINT:PRINT
  90. 7020 POKE 646,5
  91. 7030 IF F2=2 THEN 7060
  92. 7040 FI$="ANNLEVENTS"
  93. 7050 PRINT "WRITING ANNUAL EVENTS":(null) TO 7080
  94. 7060 FI$="ONETEVENTS"
  95. 7070 PRINT "WRITING ONE TIME EVENTS"
  96. 7080 OPEN 15,8,15,"S0:"+FI$
  97. 7090 OPEN 3,8,3,"0:"+FI$+",S,W"
  98. 7100 GOSUB 18000
  99. 7110 POKE 646,3
  100. 7120 PRINT#3,ID$:REM TODAY'S DATE
  101. 7130 FOR I=1 TO ND
  102. 7140 PRINT#3,DT$(I):PRINT#3,EV$(I):PRINT#3,DS(I)
  103. 7150 NEXT I
  104. 7160 DT$(ND+1)="END":PRINT#3,DT$(ND+1)
  105. 7170 CLOSE 3
  106. 7180 CLOSE 15
  107. 7190 RETURN
  108. 8000 REM SORT EVENTS INTO CHRONOLOGICAL ORDER (SUBROUTINE)
  109. 8010 FOR I=1 TO ND-1
  110. 8020 FOR J=I+1 TO ND
  111. 8030 IF DS(J)>DS(I) THEN 8070
  112. 8040 TE=DS(I):DS(I)=DS(J):DS(J)=TE
  113. 8050 TE$=DT$(I):DT$(I)=DT$(J):DT$(J)=TE$
  114. 8060 TE$=EV$(I):EV$(I)=EV$(J):EV$(J)=TE$
  115. 8070 NEXT J
  116. 8080 NEXT I
  117. 8090 RETURN
  118. 9000 REM DISPLAY ALL EVENTS
  119. 9010 GOSUB 2000:REM SELECT ONE-TIME OR ANNUAL EVENTS
  120. 9020 GOSUB 6000:REM READ THE CORRESPONDING FILE
  121. 9030 PRINT CHR$(147):PRINT:PRINT
  122. 9040 POKE 646,7
  123. 9050 PRINT "LAST ACCESS:";LA$:PRINT
  124. 9060 IF F2=2 THEN 9080
  125. 9070 PRINT "*** ANNUAL EVENTS ***":PRINT:(null) TO 9090
  126. 9080 PRINT "*** ONE-TIME EVENTS ***":PRINT
  127. 9090 POKE 646,3
  128. 9100 NL=0
  129. 9110 FOR I=1 TO ND
  130. 9120 PRINT DT$(I),EV$(I)
  131. 9130 NL=NL+1:IF NL<12 THEN 9180:REM SCREEN NOT FULL
  132. 9140 PRINT:PRINT "PRESS C TO CONTINUE[146]":NL=0
  133. 9150 GET A$:IF A$="" THEN 9150
  134. 9160 IF A$<>"C" THEN 9150
  135. 9170 PRINT CHR$(147):PRINT:PRINT
  136. 9180 NEXT I
  137. 9190 PRINT "END OF FILE"
  138. 9200 PRINT:PRINT "PRESS M FOR MENU #1[146]"
  139. 9210 GET A$:IF A$="" THEN 9210
  140. 9220 IF A$<>"M" THEN 9210
  141. 9230 (null) TO 220
  142. 10000 REM DISPLAY FUTURE EVENTS
  143. 10010 GOSUB 2000:REM SELECT ONE-TIME OR ANNUAL EVENTS
  144. 10020 GOSUB 6000:REM READ THE CORRESPONDING FILE
  145. 10030 PRINT CHR$(147):PRINT:PRINT
  146. 10040 PRINT "LAST ACCESS:";LA$:PRINT
  147. 10050 PRINT "FINAL DATE TO SEARCH?"
  148. 10060 IF F2=1 THEN PRINT "USE FORMAT MM/DD"
  149. 10070 IF F2=2 THEN PRINT "USE FORMAT MM/DD/YY"
  150. 10080 INPUT DF$
  151. 10090 LE=LEN(DF$):IF LE<6 THEN 10120:REM ANNUAL
  152. 10100 IF F2=2 THEN 10150:REM ONE TIME, OK
  153. 10110 PRINT "WRONG FORMAT":(null) TO 10060
  154. 10120 IF F2=1 THEN 10150:REM ANNUAL, OK
  155. 10130 PRINT "WRONG FORMAT":(null) TO 10070
  156. 10140 REM CONVERT TO SORT VALUE
  157. 10150 DX$=DF$:GOSUB 14000:DF=DO:REM FINAL DATE VALUE
  158. 10160 IF F2=2 THEN TS=TD:(null) TO 10190
  159. 10170 LE=LEN(ID$):DX$=LEFT$(ID$,LE-3)
  160. 10180 GOSUB 14000:TS=DO
  161. 10190 FOR I=1 TO ND
  162. 10200 IF DT$(I)="END" THEN 10250
  163. 10210 IF DS(I)<TS THEN 10240
  164. 10220 IF DS(I)>DF THEN 10240
  165. 10230 PRINT DT$(I),EV$(I)
  166. 10240 NEXT I
  167. 10250 PRINT "END"
  168. 10260 PRINT:PRINT "PRESS M FOR MENU #1[146]"
  169. 10270 GET A$:IF A$="" THEN 10270
  170. 10280 IF A$<>"M" THEN 10270
  171. 10290 (null) TO 220
  172. 11000 REM ADD OR CREATE EVENTS
  173. 11010 GOSUB 2000:REM SELECT ONE-TIME OR ANNUAL EVENTS
  174. 11020 GOSUB 5000:REM ADD, NEW OR ABORT
  175. 11030 PRINT CHR$(147):PRINT:PRINT
  176. 11040 IF F5=2 THEN 11080
  177. 11050 IF F5=3 THEN 220
  178. 11060 GOSUB 6000:REM READ EXISTING FILE
  179. 11070 I=ND+1:(null) TO 11090
  180. 11080 I=1
  181. 11090 IF F2=1 THEN 11110
  182. 11100 PRINT "USE FORMAT MM/DD/YY":(null) TO 11120
  183. 11110 PRINT "USE FORMAT MM/DD"
  184. 11120 PRINT "USE END[146] TO TERMINATE DATA ENTRY"
  185. 11130 PRINT:INPUT "DATE";DT$(I)
  186. 11140 IF DT$(I)="END" THEN 11240
  187. 11150 IF F2=2 THEN D8$=DT$(I):PRINT:GOSUB 16000:FOR J=1 TO 1000:NEXT J
  188. 11160 LE=LEN(DT$(I)):IF LE<6 THEN 11190:REM ANNUAL FILE
  189. 11170 IF F2=2 THEN 11210:REM ONE-TIME, FORMAT OK
  190. 11180 PRINT "WRONG FORMAT":(null) TO 11110
  191. 11190 IF F2=1 THEN 11210:REM ANNUAL, FORMAT OK
  192. 11200 PRINT "WRONG FORMAT":(null) TO 11100
  193. 11210 PRINT:INPUT "EVENT";EV$(I)
  194. 11220 DX$=DT$(I):GOSUB 14000:DS(I)=DO:REM CALCULATE SORT VALUE
  195. 11230 I=I+1:(null) TO 11130
  196. 11240 ND=I-1
  197. 11250 GOSUB 8000:REM PUT FILE IN CHRON. ORDER
  198. 11260 GOSUB 7000:REM WRITE THE FILE
  199. 11270 (null) TO 220
  200. 12000 REM DELETE EVENTS
  201. 12010 GOSUB 2000:REM SELECT ONE-TIME OR ANNUAL EVENTS
  202. 12020 GOSUB 6000:REM READ THE CORRESPONDING FILE
  203. 12030 PRINT CHR$(147):PRINT:PRINT
  204. 12040 PRINT TAB(14)"*** MENU #3 ***":PRINT
  205. 12050 POKE 646,3
  206. 12060 PRINT TAB(5)"1 - DELETE ALL PAST EVENTS"
  207. 12070 PRINT TAB(5)"2 - DELETE EVENTS FROM LIST"
  208. 12080 PRINT TAB(5)"3 - DELETE EVENTS FOR A GIVEN DATE"
  209. 12090 PRINT TAB(5)"4 - RETURN TO MENU #1"
  210. 12100 POKE 646,7
  211. 12110 PRINT:PRINT TAB(12)"ENTER SELECTION[146]"
  212. 12120 GET A$:IF A$="" THEN 12120
  213. 12130 ON VAL(A$) GOTO 12140,12270,12430,220
  214. 12140 IF F2=1 THEN PRINT:PRINT "NOT USED FOR ANNUAL FILE":(null) TO 12160
  215. 12150 (null) TO 12170
  216. 12160 FOR I=1 TO 2500:NEXT:(null) TO 220
  217. 12170 I=1
  218. 12180 IF TD<=DS(I) THEN 12230
  219. 12190 FOR J=I+1 TO ND+1
  220. 12200 DT$(J-1)=DT$(J):EV$(J-1)=EV$(J):DS(J-1)=DS(J)
  221. 12210 NEXT J
  222. 12220 ND=ND-1:I=I-1
  223. 12230 I=I+1:IF I>ND THEN 12250
  224. 12240 (null) TO 12180
  225. 12250 GOSUB 7000:REM WRITE THE REVISED FILE
  226. 12260 (null) TO 220
  227. 12270 I=1
  228. 12280 PRINT:PRINT DT$(I);TAB(10);EV$(I)
  229. 12290 PRINT:PRINT TAB(8)"DELETE THIS EVENT?"
  230. 12300 GET A$:IF A$="" THEN 12300
  231. 12310 IF A$="Y" THEN 12350
  232. 12320 IF A$="N" THEN 12390
  233. 12330 POKE 646,5
  234. 12340 PRINT:PRINT "ANSWER Y OR N":POKE 646,3:GOTO 12300
  235. 12350 FOR J=I+1 TO ND+1
  236. 12360 DT$(J-1)=DT$(J):EV$(J-1)=EV$(J):DS(J-1)=DS(J)
  237. 12370 NEXT J
  238. 12380 ND=ND-1:I=I-1
  239. 12390 I=I+1:IF I>ND THEN 12410
  240. 12400 (null) TO 12280
  241. 12410 GOSUB 7000:REM WRITE THE REVISED FILE
  242. 12420 (null) TO 220
  243. 12430 PRINT:PRINT "ENTER THE DATE TO DELETE"
  244. 12440 IF F2=1 THEN 12460
  245. 12450 PRINT "USE FORMAT MM/DD/YY":(null) TO 12470
  246. 12460 PRINT "USE FORMAT MM/DD"
  247. 12470 INPUT DE$
  248. 12480 LE=LEN(DE$):IF LE<6 THEN 12510:REM ANNUAL
  249. 12490 IF F2=2 THEN 12530:REM ONE-TIME,OK
  250. 12500 PRINT "WRONG FORMAT":(null) TO 12460
  251. 12510 IF F2=1 THEN 12530:REM ANNUAL, OK
  252. 12520 PRINT "WRONG FORMAT":(null) TO 12450
  253. 12530 I=1
  254. 12540 IF DT$(I)<>DE$ THEN 12590
  255. 12550 FOR J=I+1 TO ND+1
  256. 12560 DT$(J-1)=DT$(J):EV$(J-1)=EV$(J):DS(J-1)=DS(J)
  257. 12570 NEXT J
  258. 12580 ND=ND-1:I=I-1
  259. 12590 I=I+1:IF I>ND THEN 12610
  260. 12600 (null) TO 12540
  261. 12610 GOSUB 7000:REM WRITE THE REVISED FILE
  262. 12620 (null) TO 220
  263. 13000 REM PRINT FILES ON THE PRINTER
  264. 13010 GOSUB 2000:REM SELECT ONE-TIME OR ANNUAL EVENTS
  265. 13020 GOSUB 6000:REM READ THE CORRESPONDING FILE
  266. 13030 OPEN 4,4
  267. 13040 PRINT#4,"LAST ACCESS:";LA$:PRINT#4
  268. 13050 IF F2=2 THEN 13070
  269. 13060 PRINT#4,TAB(6);"*** ANNUAL EVENTS ***":PRINT#4:(null) TO 13080
  270. 13070 PRINT#4,TAB(6);"*** ONE-TIME EVENTS ***":PRINT#4
  271. 13080 FOR I=1 TO ND
  272. 13090 T1=16-LEN(DT$(I))
  273. 13100 PRINT#4,DT$(I)TAB(T1)EV$(I)
  274. 13110 NEXT I
  275. 13120 PRINT#4,"END OF FILE":PRINT#4:PRINT#4
  276. 13130 CLOSE 4
  277. 13140 (null) TO 220
  278. 14000 REM CALCULATE SORT VALUE (SUBROUTINE, ARGS: DX$,DO)
  279. 14010 LE=LEN(DX$):IF LE<6 THEN 14040
  280. 14020 YY$=RIGHT$(DX$,2):REM YEAR
  281. 14030 DX$=LEFT$(DX$,LE-3):L=LEN(DX$):(null) TO 14050
  282. 14040 L=LE
  283. 14050 IF L=3 THEN 14100:REM DX$=N/NN
  284. 14060 IF L=5 THEN 14110:REM DX$=NN/NN
  285. 14070 DY$=RIGHT$(DX$,2)
  286. 14080 IF LEFT$(DY$,1)<>"/" THEN 14120:REM DX$=N/NN
  287. 14090 (null) TO 14130:REM DX$=NN/N
  288. 14100 DD$="0"+RIGHT$(DX$,1):MM$="0"+LEFT$(DX$,1):(null) TO 14140
  289. 14110 DD$=RIGHT$(DX$,2):MM$=LEFT$(DX$,2):(null) TO 14140
  290. 14120 DD$=RIGHT$(DX$,2):MM$="0"+LEFT$(DX$,1):(null) TO 14140
  291. 14130 DD$="0"+RIGHT$(DX$,1):MM$=LEFT$(DX$,2)
  292. 14140 IF LE<6 THEN 14160
  293. 14150 DS$=YY$+MM$+DD$:(null) TO 14170
  294. 14160 DS$=MM$+DD$
  295. 14170 DO=VAL(DS$)
  296. 14180 RETURN
  297. 15000 REM USES GREGORIAN CALENDAR (SUBROUTINE)
  298. 15010 DATA JANUARY,FEBRUARY,MARCH,APRIL
  299. 15020 DATA MAY,JUNE,JULY,AUGUST,SEPTEMBER
  300. 15030 DATA OCTOBER,NOVEMBER,DECEMBER
  301. 15040 DATA SATURDAY,SUNDAY,MONDAY,TUESDAY
  302. 15050 DATA WEDNESDAY,THURSDAY,FRIDAY
  303. 15060 DIM M$(12),W$(6),L$(200)
  304. 15070 FOR J=1 TO 12:READ M$(J):NEXT J
  305. 15080 FOR J=0 TO 6:READ W$(J):NEXT J
  306. 15090 RETURN
  307. 16000 REM GET MONTH, DAY AND YEAR FROM D8$ (SUBROUTINE)
  308. 16010 M$=LEFT$(D8$,2):M=VAL(M$)
  309. 16020 MR$=RIGHT$(M$,1)
  310. 16030 IF MR$="/" THEN 16050
  311. 16040 D$=MID$(D8$,4,2):(null) TO 16060
  312. 16050 D$=MID$(D8$,3,2)
  313. 16060 DR$=RIGHT$(D$,1)
  314. 16070 IF DR$="/" THEN 16090
  315. 16080 D=VAL(D$):(null) TO 16100
  316. 16090 D=VAL(LEFT$(D$,1))
  317. 16100 Y=VAL(RIGHT$(D8$,2))
  318. 16110 GOSUB 17000
  319. 16120 PRINT "(";W$(DY);", ";M$(M);D;", ";Y")"
  320. 16130 RETURN
  321. 17000 REM DETERMINE THE DAY OF THE WEEK (SUBROUTINE)
  322. 17010 YR=1900 + Y:Y=YR
  323. 17020 C1=365*YR+D+31*M-31
  324. 17030 IF M>=3 THEN 17050
  325. 17040 YR=YR-1:E=0:GOTO 17060
  326. 17050 E=-INT(.4*M+2.3)
  327. 17060 PH=INT(YR/4)
  328. 17070 PS=INT(.75*(1+INT(YR/100)))
  329. 17080 FA=C1+E+PH-PS
  330. 17090 DY=FA-7*INT(FA/7)
  331. 17100 RETURN
  332. 18000 REM DISK ERROR SUBROUTINE
  333. 18010 INPUT#15,EN,EM$,ET,ES
  334. 18020 IF EN>1 AND EN<>50 THEN PRINT EN,EM$,ET,ES:STOP
  335. 18030 RETURN
  336.